Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / 8087.arc / 87STACK.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1985-02-13 | 17.5 KB | 304 lines

1000 ' |---------------------------------------------| 1010 ' | Example for 8087 Programming, Part 3 | 1020 ' | Personal Computer Age 3.1 Solveware | 1030 ' | Demonstrate 8087 Register Stack Operations | 1040 ' |---------------------------------------------| 1050 ' 1060 '*Reserve space for machine 1070 '*language subroutines 1080 CLEAR ,29999 1090 '*Initialize screen, variable 1100 '*types, 8087 tag word masks, 1110 '*and subroutine starting 1120 '*addresses 1130 CLS :KEY OFF :PRINT "Storing machine code. . ." 1140 DEFINT A-Z :DIM MASK(3), MTAG(7) 1150 MASK(0)=3 :MASK(1)=12 :MASK(2)=48 :MASK(3)=192 1160 INIT87=30000 1170 LD87=30020 1180 ADD87=30070 1190 MUL87=30100 1200 ST87=30130 1210 TRANS=30180 1220 ' 1230 '*Load machine language 1240 '*subroutines 1250 ADDR=INIT87 :CHKSUM=2383 :ROUTINE$="INIT87" :GOSUB 1670 1260 ADDR=LD87 :CHKSUM=4935 :ROUTINE$="LD87" :GOSUB 1670 1270 ADDR=ADD87 :CHKSUM=2765 :ROUTINE$="ADD87" :GOSUB 1670 1280 ADDR=MUL87 :CHKSUM=2773 :ROUTINE$="MUL87" :GOSUB 1670 1290 ADDR=ST87 :CHKSUM=4912 :ROUTINE$="ST87" :GOSUB 1670 1300 ADDR=TRANS :CHKSUM=5092 :ROUTINE$="TRANS" :GOSUB 1670 1310 '*Describe calculation to 1320 '*be demonstrated and 1330 '*get parameter values 1340 CLS 1350 LOCATE 3,10 :PRINT "The equation to be solved is:" 1360 LOCATE 5,30 :PRINT "X=(A+B)*(C+D)" 1370 LOCATE 8,10 :INPUT "Enter the value of A: ",A! 1380 LOCATE 8,29:PRINT SPC(15):LOCATE 8,29:INPUT "B: ",B! 1390 LOCATE 8,29:PRINT SPC(15):LOCATE 8,29:INPUT "C: ",C! 1400 LOCATE 8,29:PRINT SPC(15):LOCATE 8,29:INPUT "D: ",D! 1410 ' 1420 '*Perform demonstration 1430 ' 1440 GOSUB 1770 1450 ADDR=32000 1460 CALL INIT87(ADDR) :IN$="FINIT" :GOSUB 1910 :GOSUB 2160 1470 CALL LD87(A!,ADDR) :IN$="FLD " :GOSUB 1910 :GOSUB 2160 1480 CALL LD87(B!,ADDR) :IN$="FLD " :GOSUB 1910 :GOSUB 2160 1490 CALL ADD87(ADDR) :IN$="FADD " :GOSUB 1910 :GOSUB 2160 1500 CALL LD87(C!,ADDR) :IN$="FLD " :GOSUB 1910 :GOSUB 2160 1510 CALL LD87(D!,ADDR) :IN$="FLD " :GOSUB 1910 :GOSUB 2160 1520 CALL ADD87(ADDR) :IN$="FADD " :GOSUB 1910 :GOSUB 2160 1530 CALL MUL87(ADDR) :IN$="FMUL " :GOSUB 1910 :GOSUB 2160 1540 CALL ST87(X!,ADDR) :IN$="FSTP " :GOSUB 1910 1550 ' 1560 LOCATE 16,60 :PRINT "Result is:" :LOCATE 18,59 :PRINT X! 1570 ' 1580 '*Calculate another or exit 1590 ' 1600 LOCATE 22,1 :PRINT "Do you wish to calculate again (y/n)?" 1610 Q$=INKEY$ :IF Q$="" THEN 1610 ELSE IF Q$="y" OR Q$="Y" THEN 1340 ELSE IF Q$="n" OR Q$="N"THEN 1620 ELSE BEEP: GOTO 1610 1620 CLS 1630 END 1640 '*Subroutine to load machine 1650 '*language instructions 1660 '*(hex values) 1670 READ M: IF M<>1000 THEN POKE ADDR,M:CHKSUM=CHKSUM-M:ADDR=ADDR+1:GOTO 1670 ELSE IF CHKSUM=0 THEN RETURN 1680 ' 1690 '*Checksum error 1700 ' 1710 PRINT :PRINT "Coding errors in ";ROUTINE$;"--please check DATA statements" 1720 ' 1730 END 1740 ' 1750 '*Subroutine to draw 1760 '*stack diagram 1770 CLS 1780 L1$=STRING$(18,205) :L2$=STRING$(18,32) 1790 LOCATE 3,30 :PRINT CHR$(201)+L1$+CHR$(187) 1800 FOR REGNUM=0 TO 6 1810 LOCATE 2*REGNUM+4,23 :PRINT "ST(";CHR$(REGNUM+48);") "+CHR$(186)+L2$+CHR$(186) 1820 LOCATE 2*REGNUM+5,30 :PRINT CHR$(204)+L1$+CHR$(185) 1830 NEXT 1840 LOCATE 18,23 :PRINT "ST(7) "+CHR$(186)+L2$+CHR$(186) 1850 LOCATE 19,30 :PRINT CHR$(200)+L1$+CHR$(188) 1860 LOCATE 4,60 :PRINT "Last instruction:" 1870 RETURN 1880 ' 1890 '*Subroutine to update 1900 '*stack values 1910 LOCATE 6,60 :PRINT IN$ 1920 TAG=PEEK(ADDR+4) 1930 FOR I=0 TO 3 :MTAG(I)=(TAG AND MASK(I) )/4^I :NEXT 1940 TAG=PEEK(ADDR+5) 1950 FOR I=4 TO 7 :MTAG(I)=(TAG AND MASK(I-4))/4^(I-4) :NEXT 1960 TOP=(PEEK (ADDR+3) AND 56)/8 1970 FOR I=0 TO 7 1980 J=(TOP+I) MOD 8 1990 IF MTAG(J)<>0 THEN 2060 2000 INPAD=ADDR+14+10*I 2010 CALL TRANS(INPAD,OUTPT!) 2020 ST$=STR$(OUTPT!) 2030 FOR K=1 TO 16 -LEN(ST$) 2040 IF (K MOD 2)<>0 THEN ST$=ST$ + " " ELSE ST$=" "+ST$ 2050 NEXT K 2060 IF MTAG(J)=1 THEN ST$=" zero ":GOTO 2100 2070 IF MTAG(J)=2 THEN ST$=" special ":GOTO 2100 2080 IF MTAG(J)=3 THEN ST$=" empty ":GOTO 2100 2090 ' 2100 LOCATE 4+2*I,32 :PRINT ST$ 2110 NEXT I 2120 RETURN 2130 ' 2140 '*Subroutine to 2150 '*continue on request 2160 LOCATE 22,1 :PRINT "Press any key to continue. . ." 2170 A$=INKEY$:IF A$="" THEN 2170 2180 RETURN 2190 ' 2200 ' |-----------------------------------------| 2210 ' | INIT87: 8087 Intialization Routine | 2220 ' |-----------------------------------------| 2230 ' 2240 '*Get argument addresses 2250 ' 2260 DATA &h55: 'push bp 2270 DATA &h8B, &hEC: 'mov bp,sp 2280 DATA &h8B, &h5E, &h06: 'mov bx,[bp]+6 2290 DATA &h8B, &h3F: 'mov di,[bx] 2300 ' 2310 '*Initialize the 8087 2320 '*and save its state 2330 DATA &h9B, &hDB, &hE3: 'finit 2340 DATA &h9B, &hDD, &h35: 'fsave [di] 2350 DATA &h9B: 'fwait 2360 ' 2370 '*Restore the BP register 2380 '*and return to BASIC 2390 DATA &h5D: 'pop bp 2400 DATA &hCA, &h02, &h00: 'ret 2 2410 DATA 1000 2420 ' 2430 ' |-----------------------------------------| 2440 ' | LD87: 8087 Parameter Loading Routine | 2450 ' |-----------------------------------------| 2460 ' 2470 '*Get argument addresses 2480 ' 2490 DATA &h55: 'push bp 2500 DATA &h8B, &hEC: 'mov bp,sp 2510 DATA &h8B, &h76, &h08: 'mov si,[bp]+8 2520 DATA &h8B, &h5E, &h06: 'mov bx,[bp]+6 2530 DATA &h8B, &h3F: 'mov di,[bx] 2540 '*Convert input from 2550 '*single-precision BASIC 2560 '*to 8087 short real format 2570 DATA &h8B, &h44, &h02: 'mov ax,[si]+2 2580 DATA &h80, &hFC, &h02: 'cmp ah,2 2590 DATA &h72, &h0A: 'jb (+10) 2600 DATA &h80, &hEC, &h02: 'sub ah,2 2610 DATA &hD0, &hC0: 'rol al,1 2620 DATA &hD1, &hC8: 'ror ax,1 2630 DATA &h89, &h44, &h02: 'mov [si]+2.ax 2640 '*Restore state, load 2650 '*parameter into 8087 stack, 2660 '*and save the state 2670 DATA &h9B, &hDD, &h25: 'frstor [di] 2680 DATA &h9B, &hD9, &h04: 'fld dword ptr [si] 2680 DATA &h9B, &hD9, &h04: 'fld dword ptr [si] 2690 DATA &h9B, &hDD, &h35: 'fsave [di] 2700 DATA &h9B: 'fwait 2710 ' 2720 '*Restore the BP register 2730 '*and return to BASIC 2740 DATA &h5D: 'pop bp 2750 DATA &hCA, &h04, &h00: 'ret 4 2760 DATA 1000 2770 ' 2780 ' |------------------------------------| 2790 ' | ADD87: 8087 Addition Routine | 2800 ' |------------------------------------| 2810 ' 2820 '*Get argument addresse 2830 ' 2840 DATA &h55: 'push bp 2850 DATA &h8B, &hEC: 'mov bp,sp 2860 DATA &h8B, &h5E, &h06: 'mov bx,[bp]+6 2870 DATA &h8B, &h3F: 'mov di,[bx] 2880 '*Restore state, 2890 '*add ST to ST(1) and pop, 2900 '*save 8087 state 2910 DATA &h9B, &hDD, &h25: 'frstor [di] 2920 DATA &h9B, &hDE, &hC1: 'faddp st(1),st 2930 DATA &h9B, &hDD, &h35: 'fsave [di] 2940 DATA &h9B: 'fwait 2950 ' 2960 '*Restore the BP register 2970 '*and return to BASIC 2980 DATA &h5D: 'pop bp 2990 DATA &hCA, &h02, &h00: 'ret 2 3000 DATA 1000 3010 ' 3020 ' |---------------------------------------| 3030 ' | MUL87: 8087 Mulitiplication Routine | 3040 ' |---------------------------------------| 3050 ' 3060 '*Get argument addresses 3070 ' 3080 DATA &h55: 'push bp 3090 DATA &h8B, &hEC: 'mov bp,sp 3100 DATA &h8B, &h5E, &h06: 'mov bx,[bp]+6 3110 DATA &h8B, &h3F: 'mov di,[bx] 3120 '*Restore state, 3130 '*multiply ST(1) by ST 3140 '*and pop, save 8087 state 3150 DATA &h9B, &hDD, &h25: 'frstor [di] 3160 DATA &h9B, &hDE, &hC9: 'fmulp st(1),st 3170 DATA &h9B, &hDD, &h35: 'fsave [di] 3180 DATA &h9B: 'fwait 3190 ' 3200 '*Restore the BP register 3210 '*and return to BASIC 3220 DATA &h5D: 'pop bp 3230 DATA &hCA, &h02, &h00: 'ret 2 3240 DATA 1000 3250 ' 3260 ' |----------------------------------------| 3270 ' | ST87: 8087 Parameter Storing Routine | 3280 ' |----------------------------------------| 3290 ' 3300 '*Get argument addresses 3310 ' 3320 DATA &h55: 'push bp 3330 DATA &h8B, &hEC: 'mov bp,sp 3340 DATA &h8B, &h76, &h08: 'mov si.[bp]+8 3350 DATA &h8B, &h5E, &h06: 'mov bx,[bp]+6 3360 DATA &h8B, &h3F: 'mov di,[bx] 3370 '*Restore state, 3380 '*save parameter from 8087 3390 '*stack, and save the state 3400 DATA &h9B, &hDD, &h25: 'frstor [di] 3410 DATA &h9B, &hD9, &h1C: 'fstp dword ptr [si] 3420 DATA &h9B, &hDD, &h35: 'fsave [di] 3430 DATA &h9B: 'fwait 3440 '*Convert input from 8087 3450 '*short real format to 3460 '*single-precision BASIC 3470 DATA &h8B, &h44, &h02: 'mov ax,[si]+2 3480 DATA &hD1, &hC0: 'rol ax,1 3490 DATA &hD0, &hC8: 'ror al,1 3500 DATA &h80, &hFC, &h00: 'cmp ah,0 3510 DATA &h74, &h03: 'je (+3) 3520 DATA &h80, &hC4, &h02: 'add ah,2 3530 DATA &h89, &h44, &h02: 'mov [si]+2,ax 3540 ' 3550 '*Restore the BP register 3560 '*and return to BASIC 3570 DATA &h5D: 'pop bp 3580 DATA &hCA, &h04, &h00: 'ret 2 3590 DATA 1000 3600 ' 3610 ' |-----------------------------------------| 3620 ' | TRANS: Variable Type Conversion Routine | 3630 ' |-----------------------------------------| 3640 ' 3650 '*Get argument addresses 3660 ' 3670 DATA &h55: 'push bp 3680 DATA &h8B, &hEC: 'mov bp,sp 3690 DATA &h8B, &h5E, &h08: 'mov bx,[bp]+8 3700 DATA &h8B, &h37: 'mov si,word ptr [bx] 3710 DATA &h8B, &h7E, &h06: 'mov di,[bp]+6 3720 DATA &h9B, &hDB, &hE3: 'finit 3730 '*Initialize 8087, load 3740 '*register contents (in 3750 '*temporary real format), 3760 '*store register contents 3770 '*saved by previous FSAVE 3780 '*in short real format. 3790 DATA &h9B, &hDB, &h2C: 'fld tbyte ptr [si] 3800 DATA &h9B, &hD9, &h1D: 'fstp dword ptr [di] 3810 DATA &h9B: 'fwait 3820 '*Convert input from 8087 3830 '*short real format to 3840 '*single-precision BASIC 3850 DATA &h8B, &h45, &h02: 'mov ax,word ptr [di]+2 3860 DATA &hD1, &hC0: 'rol ax,1 3870 DATA &hD0, &hC8: 'ror al,1 3880 DATA &h80, &hFC, &h00: 'cmp ah,0 3890 DATA &h74, &h03: 'je (+3) 3900 DATA &h80, &hC4, &h02: 'add ah,2 3910 DATA &h89, &h45, &h02: 'mov word ptr [di]+2,ax 3920 ' 3930 '*Restore the BP register 3940 '*and return to BASIC 3950 DATA &h5D: 'pop bp 3960 DATA &hCA, &h04, &h00: 'ret 4 3970 '*"Flag" value signals end 3980 '*of data to terminate 3990 '*loops (typical for all 4000 '*named subroutines) 4010 DATA 1000 4020 END